home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / UTILITY / XACCSPY / SOURCE / XACCSPY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-14  |  18.6 KB  |  636 lines
  1. {$IFDEF DEBUG}
  2.     {$B+,D+,G-,I-,L+,N-,P-,Q+,R+,S+,T-,V-,X+,Z+}
  3. {$ELSE}
  4.     {$B+,D-,G-,I-,L-,N-,P-,Q-,R-,S-,T-,V-,X+,Z+}
  5. {$ENDIF}
  6.  
  7. program XAccSpy;
  8.  
  9. uses
  10.  
  11.     Gem,OTypes,OProcs,OWindows,OValidat,ODialogs,OStdWnds;
  12.  
  13. const
  14.  
  15.     {$I xaccspy.i}
  16.     XSVER = '14.04.1994';
  17.  
  18. type
  19.  
  20.     TRNSBUFFER = record
  21.         hlen : string[5];
  22.         hprot,
  23.         wsave: integer
  24.     end;
  25.  
  26.     PMyTextWindow = ^TMyTextWindow;
  27.     TMyTextWindow = object(TTextWindow)
  28.         procedure SetupSize; virtual;
  29.     end;
  30.  
  31.     PXAccApplication = ^TXAccApplication;
  32.     TXAccApplication = object(TApplication)
  33.         tbuffer: TRNSBUFFER;
  34.         HWind  : PMyTextWindow;
  35.         function GetIconTitle: string; virtual;
  36.         procedure InitInstance; virtual;
  37.         procedure InitMainWindow; virtual;
  38.         procedure IconPaint(Work: GRECT; var PaintInfo: TPaintStruct); virtual;
  39.         function XAccInsert(accID,mID: integer; Msg,Ver: byte; pName: PChar): boolean; virtual;
  40.         procedure XAccExit(OrgID: integer); virtual;
  41.         function AVInsert(accID: integer; SrvMsg,AccMsg: word; AName: string): boolean; virtual;
  42.         procedure AVExit(OrgID: integer); virtual;
  43.         procedure MUMesag(data: TEventData); virtual;
  44.     end;
  45.  
  46.     PXAccWindow = ^TXAccWindow;
  47.     TXAccWindow = object(TDialog)
  48.         InfoWnd: PDialog;
  49.         destructor Done; virtual;
  50.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  51.         procedure SetupSize; virtual;
  52.         procedure SetupWindow; virtual;
  53.         function GetIconTitle: string; virtual;
  54.         function GetStyle: integer; virtual;
  55.         procedure UpdateDialog; virtual;
  56.         procedure GetWorkMax(var maxX,maxY: integer); virtual;
  57.         procedure Paint(var PaintInfo: TPaintStruct); virtual;
  58.         procedure IconPaint(var PaintInfo: TPaintStruct); virtual;
  59.         procedure WMRButton(mX,mY,KStat,Clicks: integer); virtual;
  60.         function ExitDlg(AnIndx: integer): boolean; virtual;
  61.         function OK: boolean; virtual;
  62.         function Help: boolean; virtual;
  63.     end;
  64.  
  65.     PHistory = ^THistory;
  66.     THistory = object(TToolbar)
  67.         procedure Work; virtual;
  68.     end;
  69.  
  70.     PSetup = ^TSetup;
  71.     TSetup = object(TToolbar)
  72.         procedure Work; virtual;
  73.     end;
  74.  
  75.     PInfButton = ^TInfButton;
  76.     TInfButton = object(TButton)
  77.         tbuf: TRNSBUFFER;
  78.         procedure Changed(AnIndx: integer; DblClick: boolean); virtual;
  79.     end;
  80.  
  81. var
  82.  
  83.     XAccApplication: TXAccApplication;
  84.  
  85.  
  86. procedure XSResource; external;  {$L xaccspy.o}
  87. procedure XSCResource; external; {$L xacccolr.o}
  88.  
  89.  
  90.  
  91. procedure TMyTextWindow.SetupSize;
  92.  
  93.     begin
  94.         inherited SetupSize;
  95.         SliceMouse;
  96.         Curr.X:=GetPrivateProfileInt('History','Window.X',Curr.X,'XACCSPY.INF');
  97.         SliceMouseNext;
  98.         Curr.Y:=GetPrivateProfileInt('History','Window.Y',Curr.Y,'XACCSPY.INF');
  99.         SliceMouseNext;
  100.         Curr.W:=GetPrivateProfileInt('History','Window.W',Curr.W,'XACCSPY.INF');
  101.         SliceMouseNext;
  102.         Curr.H:=GetPrivateProfileInt('History','Window.H',Curr.H,'XACCSPY.INF');
  103.         ArrowMouse;
  104.         GRtoA2(Curr);
  105.         Calc(WC_WORK,Curr,Work);
  106.         Class.Style:=Class.Style and not(cs_AutoOpen);
  107.         DisableAutoCreate
  108.     end;
  109.  
  110.  
  111. function TXAccApplication.GetIconTitle: string;
  112.  
  113.     begin
  114.         GetIconTitle:='XACC-SPY'
  115.     end;
  116.  
  117.  
  118. function TXAccWindow.GetStyle: integer;
  119.  
  120.     begin
  121.         GetStyle:=TWindow.GetStyle { _nicht_ von TDialog! }
  122.     end;
  123.  
  124.  
  125. procedure TXAccApplication.InitInstance;
  126.  
  127.     begin
  128.         HWind:=nil;
  129.         OpenPrivateProfile('XACCSPY.INF');
  130.         InitResource(@XSResource,@XSCResource);
  131.         SliceMouse;
  132.         with tbuffer do
  133.             begin
  134.                 hlen:=GetPrivateProfileString('History','Length','50','XACCSPY.INF');
  135.                 SliceMouseNext;
  136.                 hprot:=GetPrivateProfileInt('History','Save',bf_Checked,'XACCSPY.INF');
  137.                 SliceMouseNext;
  138.                 wsave:=GetPrivateProfileInt('Setup','Save',bf_Unchecked,'XACCSPY.INF')
  139.             end;
  140.         ArrowMouse;
  141.         inherited InitInstance;
  142.         new(HWind,Init(MainWindow,'HISTORY (XAcc-Spy)',atol(tbuffer.hlen),0))
  143.     end;
  144.  
  145.  
  146. procedure TXAccApplication.InitMainWindow;
  147.     var p: PXAccWindow;
  148.  
  149.     begin
  150.         new(p,Init(nil,'ObjectGEM XAcc-Spy',XSWINDOW));
  151.         if (MainWindow=nil) or (ChkError<em_OK) then Status:=em_InvalidMainWindow
  152.         else
  153.             begin
  154.                 new(PButton,Init(p,XSWINFO,id_No,true,'Zeigt Informationen über XAcc-Spy an.'));
  155.                 new(PButton,Init(p,XSWHELP,id_Help,false,'Zeigt einen Hilfstext an.'));
  156.                 if AppFlag then p^.MakeWindow
  157.             end
  158.     end;
  159.  
  160.  
  161. procedure TXAccApplication.IconPaint(Work: GRECT; var PaintInfo: TPaintStruct);
  162.     var dummy,cnt: integer;
  163.  
  164.     begin
  165.         if XAccList<>nil then cnt:=XAccList^.Count
  166.         else
  167.             cnt:=0;
  168.         vst_point(vdiHandle,8,dummy,dummy,dummy,dummy);
  169.         v_gtext(vdiHandle,Work.X,Work.Y+(Work.H shr 1),'  '+ltoa(cnt)+' APP.');
  170.         vst_height(vdiHandle,SysInfo.SFHeight,dummy,dummy,dummy,dummy)
  171.     end;
  172.  
  173.  
  174. procedure ZeichneNeu(p: PWindow);
  175.  
  176.     begin
  177.         p^.ForceRedraw
  178.     end;
  179.  
  180.  
  181. function TXAccApplication.XAccInsert(accID,mID: integer; Msg,Ver: byte; pName: PChar): boolean;
  182.  
  183.     begin
  184.         XAccInsert:=inherited XAccInsert(accID,mID,Msg,Ver,pName);
  185.         ForEachWnd(@ZeichneNeu)
  186.     end;
  187.  
  188.  
  189. procedure TXAccApplication.XAccExit(OrgID: integer);
  190.  
  191.     begin
  192.         inherited XAccExit(OrgID);
  193.         ForEachWnd(@ZeichneNeu)
  194.     end;
  195.  
  196.  
  197. function TXAccApplication.AVInsert(accID: integer; SrvMsg,AccMsg: word; AName: string): boolean;
  198.  
  199.     begin
  200.         AVInsert:=inherited AVInsert(accID,SrvMsg,AccMsg,AName);
  201.         ForEachWnd(@ZeichneNeu)
  202.     end;
  203.  
  204.  
  205. procedure TXAccApplication.AVExit(OrgID: integer);
  206.  
  207.     begin
  208.         inherited AVExit(OrgID);
  209.         ForEachWnd(@ZeichneNeu)
  210.     end;
  211.  
  212.  
  213. procedure TXAccApplication.MUMesag(data: TEventData);
  214.     var nline : string;
  215.         xattr : TXAccAttr;
  216.         pc    : PChar;
  217.         finish: integer;
  218.  
  219.     procedure Add(line: string);
  220.  
  221.         begin
  222.             if HWind=nil then exit;
  223.             while HWind^.GetNumLines>=atol(tbuffer.hlen) do HWind^.DeleteLine(0);
  224.             HWind^.AddLine(line)
  225.         end;
  226.  
  227.     begin
  228.         if (data.Pipe[0]=ACC_EXIT) or (data.Pipe[0]=AV_EXIT) then
  229.             if tbuffer.hprot=bf_Checked then
  230.                 begin
  231.                     xattr.Name:=nil;
  232.                     FindApplication('',data.Pipe[1],xattr);
  233.                     if xattr.Name<>nil then nline:=xattr.Name^
  234.                     else
  235.                         nline:='??? Prozeß #'+ltoa(data.Pipe[1]);
  236.                     nline:=' '+nline+':'+StrPSpace(16-length(nline))+'  ';
  237.                     if data.Pipe[0]=ACC_EXIT then nline:=nline+'ACC_EXIT'
  238.                     else
  239.                         nline:=nline+'AV_EXIT';
  240.                     Add(nline)
  241.                 end;
  242.         inherited MUMesag(data);
  243.         if tbuffer.hprot<>bf_Checked then exit;
  244.         case data.Pipe[0] of
  245.         ACC_ID..ACC_ACC,ACC_ACK..ACC_IMG,AV_PROTOKOLL,VA_PROTOSTATUS:
  246.             begin
  247.                 xattr.Name:=nil;
  248.                 FindApplication('',data.Pipe[1],xattr);
  249.                 if xattr.Name<>nil then nline:=xattr.Name^
  250.                 else
  251.                     nline:='Prozeß '+ltoa(data.Pipe[1]);
  252.                 nline:=' '+nline+':'+StrPSpace(16-length(nline))+'  ';
  253.                 case data.Pipe[0] of
  254.                     ACC_ID:
  255.                         nline:=nline+'ACC_ID';
  256.                     ACC_OPEN:
  257.                         nline:=nline+'ACC_OPEN';
  258.                     ACC_CLOSE:
  259.                         nline:=nline+'ACC_CLOSE';
  260.                     ACC_ACC:
  261.                         nline:=nline+'ACC_ACC';
  262.                     ACC_ACK:
  263.                         nline:=nline+'ACC_ACK';
  264.                     ACC_TEXT:
  265.                         nline:=nline+'ACC_TEXT';
  266.                     ACC_KEY:
  267.                         nline:=nline+'ACC_KEY';
  268.                     ACC_META:
  269.                         nline:=nline+'ACC_META';
  270.                     ACC_IMG:
  271.                         nline:=nline+'ACC_IMG';
  272.                     AV_PROTOKOLL:
  273.                         nline:=nline+'AV_PROTOKOLL';
  274.                     VA_PROTOSTATUS:
  275.                         nline:=nline+'VA_PROTOSTATUS'
  276.                 end;
  277.                 nline:=nline+StrPSpace(36-length(nline))+'[3]='+ltoa(data.Pipe[3])+' [4]='+ltoa(data.Pipe[4])+' [5]='+ltoa(data.Pipe[5])+' [6]='+ltoa(data.Pipe[6])+' [7]='+ltoa(data.Pipe[7]);
  278.                 if (data.Pipe[0]=ACC_ID) or (data.Pipe[0]=ACC_ACC) then
  279.                     begin
  280.                         nline:=nline+'  ';
  281.                         pc:=Ptr(word(data.Pipe[4]),word(data.Pipe[5]));
  282.                         finish:=0;
  283.                         while (length(nline)<255) and (finish<2) do
  284.                             begin
  285.                                 if pc^=#0 then
  286.                                     begin
  287.                                         nline:=nline+'.';
  288.                                         inc(finish)
  289.                                     end
  290.                                 else
  291.                                     begin
  292.                                         nline:=nline+pc^;
  293.                                         finish:=0
  294.                                     end;
  295.                                 inc(longint(pc))
  296.                             end
  297.                     end;
  298.                 Add(nline)
  299.             end;
  300.         AC_CLOSE:
  301.             Add(' AES:           *** AC_CLOSE ***')
  302.         end
  303.     end;
  304.  
  305.  
  306. destructor TXAccWindow.Done;
  307.  
  308.     begin
  309.         with PXAccApplication(Application)^ do
  310.             if tbuffer.wsave=bf_Checked then
  311.                 begin
  312.                     SliceMouse;
  313.                     if WritePrivateProfileInt('Setup','Window.X',Curr.X,'XACCSPY.INF') then
  314.                         begin
  315.                             SliceMouseNext;
  316.                             WritePrivateProfileInt('Setup','Window.Y',Curr.Y,'XACCSPY.INF');
  317.                             SliceMouseNext;
  318.                             WritePrivateProfileInt('Setup','Window.W',Curr.W,'XACCSPY.INF');
  319.                             SliceMouseNext;
  320.                             WritePrivateProfileInt('Setup','Window.H',Curr.H,'XACCSPY.INF');
  321.                             if HWind<>nil then
  322.                                 begin
  323.                                     SliceMouseNext;
  324.                                     WritePrivateProfileInt('History','Window.X',HWind^.Curr.X,'XACCSPY.INF');
  325.                                     SliceMouseNext;
  326.                                     WritePrivateProfileInt('History','Window.Y',HWind^.Curr.Y,'XACCSPY.INF');
  327.                                     SliceMouseNext;
  328.                                     WritePrivateProfileInt('History','Window.W',HWind^.Curr.W,'XACCSPY.INF');
  329.                                     SliceMouseNext;
  330.                                     WritePrivateProfileInt('History','Window.H',HWind^.Curr.H,'XACCSPY.INF')
  331.                                 end
  332.                         end;
  333.                     ArrowMouse
  334.                 end;
  335.         inherited Done
  336.     end;
  337.  
  338.  
  339. procedure TXAccWindow.GetWindowClass(var AWndClass: TWndClass);
  340.  
  341.     begin
  342.         inherited GetWindowClass(AWndClass);
  343.         with AWndClass do
  344.             Style:=Style or cs_CreateOnAccOpen or cs_FullRedraw
  345.     end;
  346.  
  347.  
  348. procedure TXAccWindow.SetupSize;
  349.  
  350.     begin
  351.         inherited SetupSize;
  352.         SliceMouse;
  353.         Curr.X:=GetPrivateProfileInt('Setup','Window.X',Curr.X,'XACCSPY.INF');
  354.         SliceMouseNext;
  355.         Curr.Y:=GetPrivateProfileInt('Setup','Window.Y',Curr.Y,'XACCSPY.INF');
  356.         SliceMouseNext;
  357.         Curr.W:=GetPrivateProfileInt('Setup','Window.W',Curr.W,'XACCSPY.INF');
  358.         SliceMouseNext;
  359.         Curr.H:=GetPrivateProfileInt('Setup','Window.H',Curr.H,'XACCSPY.INF');
  360.         ArrowMouse;
  361.         GRtoA2(Curr);
  362.         Calc(WC_WORK,Curr,Work)
  363.     end;
  364.  
  365.  
  366. procedure TXAccWindow.SetupWindow;
  367.  
  368.     begin
  369.         inherited SetupWindow;
  370.         Attr.ExStyle:=Attr.ExStyle and not(ws_ex_CenterOnce);
  371.         LoadToolbar(XSTOOL,false);
  372.         new(PHistory,Init(@self,XSTOOL,XSTHIST,K_ALT,Alt_H,nil,false,false,'Öffnet ein Fenster, das alle empfangenen XAcc- und AV-Messages auflistet'));
  373.         new(PSetup,Init(@self,XSTOOL,XSTSETUP,K_ALT,Alt_S,nil,false,false,'Öffnet das Setup-Fenster für diverse Einstellungen'));
  374.         InfoWnd:=nil
  375.     end;
  376.  
  377.  
  378. function TXAccWindow.GetIconTitle: string;
  379.  
  380.     begin
  381.         GetIconTitle:=Application^.GetIconTitle
  382.     end;
  383.  
  384.  
  385. procedure TXAccWindow.UpdateDialog;
  386.  
  387.     begin
  388.         if DlgTree<>nil then
  389.             with DlgTree^[ROOT] do
  390.                 begin
  391.                     ob_x:=Work.X2+1-ob_width;
  392.                     ob_y:=Work.Y2+1-ob_height
  393.                 end
  394.     end;
  395.  
  396.  
  397. procedure TXAccWindow.GetWorkMax(var maxX,maxY: integer);
  398.  
  399.     begin
  400.         maxX:=maxint;
  401.         maxY:=maxint
  402.     end;
  403.  
  404.  
  405. procedure TXAccWindow.Paint(var PaintInfo: TPaintStruct);
  406.     label _raus;
  407.  
  408.     var cnt,x,y,q,w,msk: integer;
  409.         txt,dummy      : string;
  410.  
  411.     begin
  412.         if Application^.XAccList<>nil then cnt:=Application^.XAccList^.Count
  413.         else
  414.             cnt:=0;
  415.         if cnt=0 then
  416.             begin
  417.                 SetSubTitle(' Keine XAcc-/AV-Applikation gefunden.');
  418.                 goto _raus
  419.             end
  420.         else
  421.             SetSubTitle(' '+ltoa(cnt)+' XAcc-/AV-Applikation(en) gefunden.');
  422.         x:=Work.X+GP.charWidth;
  423.         y:=Work.Y+GP.boxHeight;
  424.         v_gtext(vdiHandle,x,y,'Name              apID  meID  Ver  Groups  apType + Features + genName');
  425.         inc(y,GP.boxHeight shl 1);
  426.         for q:=0 to pred(cnt) do
  427.             with PXAccAttr(Application^.XAccList^.At(q))^ do
  428.                 begin
  429.                     if Name<>nil then txt:=Name^ else txt:='';
  430.                     txt:=txt+StrPSpace(16-length(Name^))+'  ';
  431.                     dummy:=ltoa(apID);
  432.                     txt:=txt+StrPSpace(3-length(dummy))+dummy+'   ';
  433.                     dummy:=ltoa(menuID);
  434.                     txt:=txt+StrPSpace(3-length(dummy))+dummy+'   ';
  435.                     dummy:=ltoa(Version);
  436.                     txt:=txt+StrPSpace(3-length(dummy))+dummy+'  ';
  437.                     msk:=1;
  438.                     if bTst(Protocol,PROTO_AV) then txt:=txt+'a' else txt:=txt+'_';
  439.                     if bTst(Protocol,PROTO_XACC) then txt:=txt+'x' else txt:=txt+'_';
  440.                     dummy:='';
  441.                     for w:=0 to 3 do
  442.                         begin
  443.                             if bTst(MsgGroups,msk) then dummy:=chr(w+49)+dummy
  444.                             else
  445.                                 dummy:='_'+dummy;
  446.                           msk:=msk shl 1
  447.                         end;
  448.                     txt:=txt+dummy+'  ';
  449.                     txt:=txt+AppTypeMR+' ';
  450.                     if AppTypeHR<>nil then txt:=txt+AppTypeHR^+'  ';
  451.                     if ExtFeatures<>nil then txt:=txt+ExtFeatures^+'  ';
  452.                     if GenericName<>nil then txt:=txt+GenericName^;
  453.                     v_gtext(vdiHandle,x,y,txt);
  454.                     inc(y,GP.boxHeight)
  455.                 end;
  456.         _raus:
  457.         inherited Paint(PaintInfo)
  458.     end;
  459.  
  460.  
  461. procedure TXAccWindow.IconPaint(var PaintInfo: TPaintStruct);
  462.  
  463.     begin
  464.         Application^.IconPaint(Work,PaintInfo)
  465.     end;
  466.  
  467.  
  468. procedure TXAccWindow.WMRButton(mX,mY,KStat,Clicks: integer);
  469.     var num : integer;
  470.         answ: string;
  471.  
  472.     begin
  473.         if mY-Work.Y<=GP.boxHeight then
  474.             begin
  475.                 num:=(mX-Work.X) div GP.boxWidth;
  476.                 if num<17 then
  477.                     answ:='Der Name der Applikation. XAcc-Programme verwenden meist einen gut lesbaren Namen, AV-Programme dagegen den Namen der Programmdatei.'
  478.                 else if (num>=18) and (num<=23) then
  479.                     answ:='Die AES-Prozeß-ID. Unter "normalem" TOS hat das Hauptprogramm die ID 0.'
  480.                 else if (num>=24) and (num<=29) then
  481.                     answ:='Die Nummer des Menüeintrags. Ist bei Accessories wichtig und wird von Programmen normalerweise auf -1 gesetzt.'
  482.                 else if (num>=30) and (num<=34) then
  483.                     answ:='Eine von der Applikation beliebig zu setzende Versionsnummer. Die Codierung ist nicht festgelegt.'
  484.                 else if (num>=35) and (num<=42) then
  485.                     answ:='Eine Bitmap der verstandenen XAcc-Message-Gruppen (v.r.n.l.). Eine akzeptierte Gruppe wird durch die entsprechende Zahl gekennzeichnet, sonst wird ein Unterstrich ausgegeben. '
  486.                           +'Links wird außerdem noch die Art des Protokolls angegeben (a=AV, x=XAcc).'                else if (num>=43) and (num<=50) then
  487.                     answ:='Der Applikations-Typ (optional). Die ersten beiden Großbuchstaben geben den maschinenlesbaren Typ an, dann folgt der "menschenlesbare".'
  488.                 else if (num>=51) and (num<=61) then
  489.                     answ:='Evtl. vorhandene erweiterte Möglichkeiten (optional). Der Inhalt ist nicht genormt, daher müssen Programme, die darauf zugreifen, das andere Programm kennen.'
  490.                 else
  491.                     answ:='Der sog. generische Name (optional). Kann verwendet werden, um ähnliche oder zusammengehörende Programme zu kennzeichnen.';
  492.                 Application^.BubbleHelp(mX,mY,500,answ)
  493.             end
  494.         else
  495.             begin
  496.                 num:=mY-Work.Y-2*GP.boxHeight-(GP.boxHeight shr 2);
  497.                 if (Application^.XAccList=nil) or (Clicks<>1) or (num<0) then exit;
  498.                 num:=num div GP.boxHeight;
  499.                 if num<Application^.XAccList^.Count then
  500.                     begin
  501.                         answ:=GetPrivateProfileString('Info',PXAccAttr(Application^.XAccList^.At(num))^.Name^,'','XACCSPY.INF');
  502.                         if length(answ)=0 then Application^.BubbleHelp(mX,mY,500,'Keine Informationen vorhanden.')
  503.                         else
  504.                             Application^.BubbleHelp(mX,mY,500,answ)
  505.                     end
  506.             end
  507.     end;
  508.  
  509.  
  510. function TXAccWindow.ExitDlg(AnIndx: integer): boolean;
  511.     var p: PStatic;
  512.  
  513.     begin
  514.         if AnIndx=XSWINFO then
  515.             begin
  516.                 if InfoWnd=nil then
  517.                     begin
  518.                         new(InfoWnd,Init(@self,'INFO (Xacc-Spy)',XSINFO));
  519.                         if InfoWnd<>nil then
  520.                             begin
  521.                                 new(p,Init(InfoWnd,XSIVER,28,true,'"Möge die OOP mit Euch sein!"'));
  522.                                 if p<>nil then p^.SetText('XACC-SPY Version '+XSVER);
  523.                                 new(p,Init(InfoWnd,XSIGO,34,false,''));
  524.                                 if p<>nil then p^.SetText('mit ObjectGEM '+VtoS(GOVersion)+' für PurePascal');
  525.                                 new(PButton,Init(InfoWnd,XSIOK,id_OK,true,'Schließt das INFO-Fenster.'))
  526.                             end
  527.                     end;
  528.                 if InfoWnd<>nil then InfoWnd^.MakeWindow
  529.             end;
  530.         ExitDlg:=false
  531.     end;
  532.  
  533.  
  534. function TXAccWindow.OK: boolean;
  535.  
  536.     begin
  537.         Application^.Quit;
  538.         OK:=true
  539.     end;
  540.  
  541.  
  542. function TXAccWindow.Help: boolean;
  543.  
  544.     begin
  545.         Application^.Alert(@self,1,NOTE,'Bringen Sie den Mauscursor über das Dialogelement, zu dem Sie Hilfe benötigen. Drücken Sie dann die <Help>- oder die rechte Maustaste.','  &OK  ');
  546.         Help:=false
  547.     end;
  548.  
  549.  
  550. procedure THistory.Work;
  551.  
  552.     begin
  553.         with PXAccApplication(Application)^ do
  554.             if HWind<>nil then HWind^.MakeWindow
  555.     end;
  556.  
  557.  
  558. procedure TSetup.Work;
  559.     var ed: PEdit;
  560.  
  561.     begin
  562.         if ADialog=nil then
  563.             begin
  564.                 new(ADialog,Init(PWindow(Parent),'SETUP (Xacc-Spy)',XSSETUP));
  565.                 if ADialog<>nil then
  566.                     begin
  567.                         new(ed,Init(ADialog,XSSHLEN,5,'Legt fest, wieviele Zeilen in der History gespeichert werden können'));
  568.                         new(PCheckBox,Init(ADialog,XSSHIST,true,'Bestimmt, ob die empfangenen Messages in der History mitprotokolliert werden sollen'));
  569.                         new(PCheckBox,Init(ADialog,XSSWIND,true,'Ist diese Checkbox markiert, wird beim Verlassen vom XAcc-Spy bzw. bei Anwahl von "INF speichern" die aktuelle Fensterposition und -größe gespeichert'));
  570.                         new(PInfButton,Init(ADialog,XSSINF,id_NoExit,true,'Nach einer Sicherheitsabfrage werden die aktuellen Einstellungen in der Datei XACCSPY.INF gespeichert'));
  571.                         new(PButton,Init(ADialog,XSSOK,id_OK,true,'Übernimmt die Einstellungen'));
  572.                         new(PButton,Init(ADialog,XSSABBR,id_Cancel,true,'Bricht den Dialog ab, ohne neue Einstellungen zu übernehmen'));
  573.                         if ed<>nil then
  574.                             ed^.SetValidator(new(PRangeValidator,Init(10,1999)));
  575.                         ADialog^.TransferBuffer:=@PXAccApplication(Application)^.tbuffer
  576.                     end
  577.             end;
  578.         if ADialog<>nil then ADialog^.MakeWindow
  579.     end;
  580.  
  581.  
  582. procedure TInfButton.Changed(AnIndx: integer; DblClick: boolean);
  583.     var tb: pointer;
  584.  
  585.     begin
  586.         if Application^.Alert(Parent,1,WAIT,'Wollen Sie XACCSPY.INF speichern?','  &Ja  | &Nein ')=1 then
  587.             begin
  588.                 with Parent^ do
  589.                     begin
  590.                         tb:=TransferBuffer;
  591.                         TransferBuffer:=@tbuf;
  592.                         TransferData(tf_GetData);
  593.                         TransferBuffer:=tb
  594.                     end;
  595.                 SliceMouse;
  596.                 if WritePrivateProfileString('History','Length',tbuf.hlen,'XACCSPY.INF') then
  597.                     begin
  598.                         SliceMouseNext;
  599.                         WritePrivateProfileInt('History','Save',tbuf.hprot,'XACCSPY.INF');
  600.                         SliceMouseNext;
  601.                         WritePrivateProfileInt('Setup','Save',tbuf.wsave,'XACCSPY.INF');
  602.                         if tbuf.wsave=bf_Checked then
  603.                             begin
  604.                                 SliceMouseNext;
  605.                                 WritePrivateProfileInt('Setup','Window.X',Parent^.Parent^.Curr.X,'XACCSPY.INF');
  606.                                 SliceMouseNext;
  607.                                 WritePrivateProfileInt('Setup','Window.Y',Parent^.Parent^.Curr.Y,'XACCSPY.INF');
  608.                                 SliceMouseNext;
  609.                                 WritePrivateProfileInt('Setup','Window.W',Parent^.Parent^.Curr.W,'XACCSPY.INF');
  610.                                 SliceMouseNext;
  611.                                 WritePrivateProfileInt('Setup','Window.H',Parent^.Parent^.Curr.H,'XACCSPY.INF');
  612.                                 if PXAccApplication(Application)^.HWind<>nil then
  613.                                     with PXAccApplication(Application)^.HWind^ do
  614.                                         begin
  615.                                             SliceMouseNext;
  616.                                             WritePrivateProfileInt('History','Window.X',Curr.X,'XACCSPY.INF');
  617.                                             SliceMouseNext;
  618.                                             WritePrivateProfileInt('History','Window.Y',Curr.Y,'XACCSPY.INF');
  619.                                             SliceMouseNext;
  620.                                             WritePrivateProfileInt('History','Window.W',Curr.W,'XACCSPY.INF');
  621.                                             SliceMouseNext;
  622.                                             WritePrivateProfileInt('History','Window.H',Curr.H,'XACCSPY.INF')
  623.                                         end
  624.                             end
  625.                     end;
  626.                 SavePrivateProfile;
  627.                 ArrowMouse
  628.             end
  629.     end;
  630.  
  631.  
  632. begin
  633.   XAccApplication.Init('XSPY','XAcc-Spy');
  634.   XAccApplication.Run;
  635.   XAccApplication.Done
  636. end.